home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
ezy_comm
/
ezy1023.zip
/
EKIT102.ZIP
/
EZYFOS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-10-24
|
21KB
|
614 lines
(* EZYFOS V1.00 (C) Peter Davues 1992. All Rights Reserved.
This unit is the copyrighted works of Peter Davies. Peter Davies
reserves all rights on this material. Use of this library is
granted freely, however due credit must be given to Peter Davies.
This source may be freely used as long as due credit is given.
That means, in your documentation, you MUST acknowledge that
"EZYFOS (C) Peter Davies 1992" was used.
If, this acknowledgement is a problem, then you MUST purchase
this unit. Cost $AUD40. Contact Peter Davies Fido 3:636/213
for purchasing details.
No liability whatsoever is given for this unit. You accept all
responsibility whatsoever.
For improvements, please contact Peter Davies Fido 3:636/213
For use with Turbo Pascal V6.0-> ONLY *)
Unit ezyfos;
{$O+,F+,R-,S-,V-}
Interface
uses crt, dos;
const
carrierdetectvalue : byte = $80; (* value to and AND for carrier *)
remoteoutput : boolean = false; (* do remote output *)
remoteinput : boolean = false; (* do remote input *)
localoutput : boolean = true; (* do local output *)
localinput : boolean = true; (* do local input *)
fossilactive : boolean = false; (* has fossil been activated? *)
curattr : byte = 7; (* Current Text Attribute *)
terminalcap : byte = 0; (* User's Terminal Capabilities *)
(* Bit 0 : ANSI
1 : Avatar
2-7 [Reserved]
TTY assumed TRUE always *)
blinking = 128; (* or with forground to blink *)
var
comport : word;
(* Fossil comport
eg 0 = com1 *)
fossilerror : word;
(* 0 = No error
1 = No carrier
2 = No Fossil
Note: Fossilerror is NOT tripped if the fossil is NOT present *)
localkey : boolean; (* whether key hit was local or not *)
type
str40 = string[40];
maxstr = string[255];
function remotedataready : boolean;
function getremotechar : char;
function getkey : word;
procedure idleloop;
procedure putremotechar(putc : char);
function initfossil : boolean;
procedure deinitfossil;
function carrierdetect : boolean;
function fossilerrorstring : str40;
procedure flushoutput;
procedure purgeoutput;
procedure sendstring(s : maxstr);
procedure sendchar(c : char);
function hotkey(var key : word) : boolean;
Implementation
(* *************************************************
* *
* Function: Remotedataready *
* *
* Description: Returns true if data ready *
* in FOSSIL "comport" *
* *
* FossilError: 0=No Error *
* 1=No Carrier *
* *
************************************************* *)
function remotedataready : boolean; assembler;
asm
mov fossilerror, 0;
cmp remoteinput, 0;
jz @noremoteinput;
mov ah, $03; (* fossil status report *)
mov dx, comport;
int $14;
and al, carrierdetectvalue; (* check carrier *)
jz @nocarrier;
and ah, $01; (* data ready or not *)
mov al, ah;
jmp @finish;
@noremoteinput :
mov al, 0;
jmp @finish;
@nocarrier :
mov fossilerror, 1;
mov al, 0;
@finish :
end;
(* *************************************************
* *
* Function: Getremotechar *
* *
* Description: Returns character *
* in FOSSIL "comport" *
* *
* Note : ONLY call if remotedataready *
* As no checking is done for *
* speed! *
* *
* *
* Cairrer : No Carrier Checking *
* *
************************************************* *)
function getremotechar : char; assembler;
asm
mov ah, $02;
mov dx, comport;
int 14h;
end;
(* *************************************************
* *
* Function: Getkey *
* *
* Description: Keeps cycling until a key *
* is hit (local or remote) or *
* carrier is dropped *
* *
* *
* Note : if no remote then only get *
* key local *
* *
* Timers : No TIMEOUTS!!! *
* *
* Returns : Character got (low byte) *
* Special Key (high byte) *
* *
* *
* FossilError : 0=No Error *
* 1=No Carrier *
* *
* Localkey : True=Local keyboard hitkey *
* False=Remote keyboard hitkey *
* *
************************************************* *)
function getkey : word;
var
chlow : byte;
chhigh : byte;
keyhit : boolean;
begin
keyhit := false;
repeat
if localinput and keypressed then (* if key hit local *)
begin
chlow := ord(readkey);
if (chlow = 0) then
chhigh := ord(readkey) else
chhigh := 0;
keyhit := true;
localkey := true;
end else
if remotedataready then (* if key hit remote *)
begin
chlow := ord(getremotechar);
chhigh := 0;
keyhit := true;
localkey := false;
end else
idleloop; (* we're waiting, give away time *)
until (keyhit) or (fossilerror > 0);
if keyhit then
getkey := word(chlow) + word(chhigh) shl 8 else
getkey := 0;
end;
(* *************************************************
* *
* Procedure: Putremotechar *
* *
* FossilError: 0=No Error *
* 1=No Carrier *
* *
* Note: Keeps cycling until enough space *
* in fossil buffer, then puts the *
* character *
* *
* Timers: No timers... *
* *
* FossilError: 0=No Error *
* 1=No Carrier *
* *
************************************************* *)
procedure putremotechar(putc : char); assembler;
asm
mov fossilerror, 0;
cmp remoteoutput, 0; (* is fossil connected to output? *)
je @finish;
(* cmp fossilactive, 0; Assumption: if RemoteOutput, Fossil IS Active
je @finish; *)
@waitforcharfree :
mov ah, $03; (* fossil status report *)
mov dx, comport;
int 14h;
and al, carrierdetectvalue; (* carrier *)
jz @nocarrier;
and ah, $20; (* room in output buffer *)
jnz @charfree;
call idleloop; (* idle time waiting for free space *)
jmp @waitforcharfree;
@nocarrier :
mov fossilerror, 1;
jmp @finish;
@charfree :
mov ah, $01; (* fossil put character *)
mov dx, comport;
mov al, putc;
int 14h;
@finish :
end;
(* *************************************************
* *
* Function: initfossil *
* *
* Note: CTS/RTS handshaking auto enabled! *
* *
* Return: True if Fossil Init OK *
* *
* FossilActive: Set True if fossil init'd *
* *
************************************************* *)
function initfossil : boolean; assembler;
asm
mov ah, $04; (* init fossil *)
mov dx, comport;
mov bx, $00;
int $14;
cmp ax, $1954; (* is fossil alive? *)
je @fossilalive;
@fossildead :
mov al, $00;
jmp @finish; (* fossil dead *)
@killfossil :
call deinitfossil;
jmp @fossildead;
@fossilalive :
cmp bh, $05; (* check fossil V5.0? *)
jb @killfossil;
cmp bl, $1B; (* check fossil functions *)
jb @killfossil;
mov ah, $0F; (* set flow control *)
mov al, $02; (* use CTS/RTS *)
mov dx, comport;
int $14;
mov al, $01; (* fossil alive *)
@finish :
mov fossilactive, al;
mov remoteoutput, al;
mov remoteinput, al;
end;
(* *************************************************
* *
* Procedure: deinitfossil *
* *
* *
* FossilActive: Set False *
* *
************************************************* *)
procedure deinitfossil; assembler;
asm
mov ah, $05; (* deinit fossil *)
mov dx, comport;
int $14;
mov al, false;
mov fossilactive, al;
mov remoteinput, al;
mov remoteoutput, al;
End;
(* *************************************************
* *
* Function: Carrier Detect *
* *
* Description: Returns true if carrier *
* *
* FossilError: 0=No Error *
* 1=No Carrier *
* 2=Fossil Not Active *
* *
* Note: Does not depend on *
* remoteinput or remoteoutput *
* *
************************************************* *)
function carrierdetect : boolean; assembler;
asm
cmp fossilactive, true; (* if fossil not alive exit *)
jne @nofossil;
mov ah, $03; (* fossil status report *)
mov dx, comport;
int $14;
and al, carrierdetectvalue; (* check carrier *)
jz @nocarrier;
mov al, $01; (* carrier found *)
mov fossilerror, $00;
jmp @finish
@nofossil :
mov fossilerror, $02;
mov al, $00;
jmp @finish;
@nocarrier :
mov fossilerror, $01;
mov al, $00;
@finish :
end;
(* *************************************************
* *
* Procedure: flush fossil output buffer *
* *
* Note: This does not use the standard *
* fossil flush routine as carrier *
* may be dropped while flushing *
* meaning that some data may never *
* get out. If, carrier drops this *
* routine aborts *
* *
* FossilError: 0=No Error *
* 1=No Carrier *
* *
************************************************* *)
procedure flushoutput; assembler;
asm
mov fossilerror, 0;
cmp fossilactive, true; (* if fossil not alive exit *)
jne @finish;
@flushloop :
mov ah, $03; (* fossil status report *)
mov dx, comport;
int $14;
and al, carrierdetectvalue; (* check carrier *)
jz @nocarrier;
and ah, $40; (* output buffer empty? *)
jnz @finish;
call idleloop; (* give away time while waiting *)
jmp @flushloop;
@nocarrier :
mov fossilerror, 1;
@finish :
end;
(* *************************************************
* *
* Procedure: purge fossil output buffer *
* *
************************************************* *)
procedure purgeoutput; assembler;
asm
cmp fossilactive, true; (* if fossil not alive exit *)
jne @finish;
mov ah, $09; (* fossil purge output function *)
mov dx, comport;
int $14;
@finish :
end;
(* *************************************************
* *
* Procedure: Idleloop *
* *
* Description: give away time to whatever *
* wants it *
* *
************************************************* *)
procedure idleloop;
begin
(* implement your multi-tasker slicing here *)
end;
(* *************************************************
* *
* Function: FossilErrorString *
* *
* Description: Returns String value of *
* FossilError *
* *
************************************************* *)
function fossilerrorstring : str40;
begin
case fossilerror of
0 : fossilerrorstring := 'No Error';
1 : fossilerrorstring := 'No Carrier';
2 : fossilerrorstring := 'No Fossil';
else fossilerrorstring := 'Unknown Error';
end;
end;
(* *************************************************
* *
* Procedure: SendString *
* *
* Description: Sends String to Comms and *
* to Local Console *
* *
* FossilError: 0=No Error *
* 1=No Carrier *
* *
* Note: String ALWAYS sent to local output *
* regardless of CARRIER *
* *
* Speed: Faster SendString is available in *
* TPU format *
* *
************************************************* *)
procedure sendstring(s : maxstr);
var
loop : word;
begin
fossilerror := 0;
if localoutput then
write(s);
if remoteoutput then
begin
loop := 1;
while (loop <= length(s)) and (fossilerror = 0) do
begin
putremotechar(s[loop]);
inc(loop);
end;
end;
end;
(* *************************************************
* *
* Procedure: StrString *
* *
* Description: Sends String to Comms *
* *
* *
* FossilError: 0=No Error *
* 1=No Carrier *
* *
* Speed: Faster StrString is available in *
* TPU format *
* *
************************************************* *)
procedure strstring(s : maxstr);
var
loop : word;
begin
fossilerror := 0;
if remoteoutput then
begin
loop := 1;
while (loop <= length(s)) and (fossilerror = 0) do
begin
putremotechar(s[loop]);
inc(loop);
end;
end;
end;
(* *************************************************
* *
* Procedure: SendChar *
* *
* Description: Sends Char to Comms and *
* to Local Console *
* *
* FossilError: 0=No Error *
* 1=No Carrier *
* *
* Note: Char ALWAYS sent to local output *
* regardless of CARRIER *
* *
************************************************* *)
procedure sendchar(c : char);
begin
if localoutput then
write(c);
putremotechar(c);
end;
(* *************************************************
* *
* Function: Hotkey *
* *
* Description: Only gets a key if it is *
* waiting *
* *
* Note : if no remote then only get *
* key local *
* *
* Key : Character got (low byte) *
* Special Key (high byte) *
* *
* Returns : True=Character received *
* False=No Character received *
* *
* *
* FossilError : 0=No Error *
* 1=No Carrier *
* *
* Localkey : True=Local keyboard hitkey *
* False=Remote keyboard hitkey *
* *
************************************************* *)
function hotkey(var key : word) : boolean;
var
chlow : byte;
chhigh : byte;
keyhit : boolean;
begin
keyhit := false;
if localinput and keypressed then (* if key hit local *)
begin
chlow := ord(readkey);
if (chlow = 0) then
chhigh := ord(readkey) else
chhigh := 0;
keyhit := true;
localkey := true;
end else
if remotedataready then (* if key hit remote *)
begin
chlow := ord(getremotechar);
chhigh := 0;
keyhit := true;
localkey := false;
end;
if keyhit then
key := word(chlow) + word(chhigh) shl 8 else
key := 0;
hotkey := keyhit;
end;
procedure txtcolour(f, b : byte);
begin
f := f and (15 + 128);
b := b and 7;
if localoutput then
begin
textattr := f or (b shl 4);
end;
if remoteoutput then
begin
if ((terminalcap and 2) = 2) then
begin
strstring(#22 + #1 + chr((f and 15) + b));
if ((f and blinking) = blinking) then
strstring(#22 + #2);
end else
if ((terminalcap and 1) = 1) then
begin
if ((f and blinking) = blinking) then
strstring(#27 + '[0;5m') else
strstring(#27 + '[0m');
end;
end;
end;
end.
